home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Over 1,000 Windows 95 Programs
/
Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso
/
1256
/
tour029.co_
/
tour029.co
Wrap
Text File
|
1997-04-18
|
12KB
|
318 lines
*---Created with EasyCODE(COB)----------------------------------- # EASY O
*---Last modification: 01.03.1995 14:24:30----------------------- # EASY K
*This program prints a customers list for each journey that is bo\
*oked out.
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
*TOUR029
*---------------------------------------------------------------- # EASY *
IDENTIFICATION DIVISION.
*---------------------------------------------------------------- # EASY (
**** Identification Division ***
*---------------------------------------------------------------- # EASY *
PROGRAM-ID. TOUR029.
*
* THIS ASYNCHRONOUS PROGRAM PRINTS A CUSTOMERS LIST
* FOR EACH JOURNEY THAT IS BOOKED OUT.
* ITS TAC : PRINT
*
*---------------------------------------------------------------- # EASY )
ENVIRONMENT DIVISION.
DATA DIVISION.
*---------------------------------------------------------------- # EASY (
**** Data Division ***
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
**** WORKING-STORAGE Section ***
*---------------------------------------------------------------- # EASY *
WORKING-STORAGE SECTION.
77 RESULTMESSAGE-1 PIC X(80)
VALUE "CUSTOMERS LIST IS BEING PRINTED".
77 RESULTMESSAGE-2 PIC X(80)
VALUE "JOURNEY HAS BEEN ERASED".
77 ERRORMESSAGE-1 PIC X(80)
VALUE "SYSTEM FAILURE - WRONG JOURNEY-ID".
77 ERRORMESSAGE-2 PIC X(80)
VALUE "SYSTEM FAILURE - JOURNEY COULD NOT BE ERASED".
77 ERRORMESSAGE-3 PIC X(80)
VALUE "SYSTEM FAILURE - CUSTOMERS LIST CANNOT BE PRINTED".
77 ERRORMESSAGE-4 PIC X(80)
VALUE "SYSTEM FAILURE - NO BOOKINGS CAN BE FOUND".
COPY KCOPC.
COPY KCDFC.
* # EASY S
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** LINKAGE Section ***
*---------------------------------------------------------------- # EASY *
LINKAGE SECTION.
COPY KCKBC.
05 DUMMY PIC X.
COPY KCPAC.
03 JOURNEY.
COPY JOURNEY.
03 BOOKING.
COPY BOOKING.
03 BOSSINF.
COPY BOSSINF.
03 LIST-HEADER.
COPY CLHEAD.
03 LIST-ELEMENT.
COPY CLELEM.
03 ERROR-SIGN PIC 9.
03 EOF PIC 9.
* # EASY S
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY )
PROCEDURE DIVISION USING KCKBC KCSPAB.
*---------------------------------------------------------------- # EASY (
**** Procedure Division ***
*---------------------------------------------------------------- # EASY *
*---------------------------------------------------------------- # EASY (
**** INIT-OPERATION ***
*---------------------------------------------------------------- # EASY *
INIT-OPERATION.
MOVE INIT TO KCOP,
MOVE 0 TO KCLKBPRG,
MOVE 1000 TO KCLPAB,
CALL "KDCS" USING KCPAC
IF KCRCCC NOT = ZERO
THEN
PERFORM PEND-OPERATION
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** FGET-OPERATION ***
*---------------------------------------------------------------- # EASY *
FGET-OPERATION.
MOVE FGET TO KCOP,
MOVE 4 TO KCLA,
MOVE SPACES TO KCMF,
CALL "KDCS" USING KCPAC, JOURNEY-ID OF JOURNEY
IF KCRCCC NOT = "000"
THEN
PERFORM PEND-OPERATION
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PROCESSING ***
*---------------------------------------------------------------- # EASY *
PROCESSING.
MOVE JOURNEY-ID OF JOURNEY TO JOURNEY-ID OF BOSSINF
CALL "RDJRNEY" USING JOURNEY, ERROR-SIGN
IF ERROR-SIGN = 0
THEN
PERFORM LIST-CAN-BE-PRODUCED
ELSE
PERFORM LIST-CANNOT-BE-PRODUCED
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** FPUT-OPERATION ***
*---------------------------------------------------------------- # EASY *
FPUT-OPERATION.
MOVE FPUT TO KCOP,
MOVE "NE" TO KCOM,
MOVE 188 TO KCLM,
MOVE "*BOSSINF" TO KCMF,
MOVE "BOSSTERM" TO KCRN,
MOVE KCREPL TO KCDF
CALL "KDCS" USING KCPAC, BOSSINF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PEND-OPERATION ***
*---------------------------------------------------------------- # EASY *
PEND-OPERATION.
MOVE PEND TO KCOP,
MOVE "FI" TO KCOM,
CALL "KDCS" USING KCPAC
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** END-OF-PROGRAM ***
*---------------------------------------------------------------- # EASY *
END-OF-PROGRAM.
EXIT PROGRAM
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** LIST-CANNOT-BE-PRODUCED ***
*---------------------------------------------------------------- # EASY *
LIST-CANNOT-BE-PRODUCED.
MOVE SPACES TO WHERE-TO-GO OF BOSSINF,
BOOKED-SEATS OF BOSSINF
* # EASY -
MOVE ERRORMESSAGE-1 TO MESSAGE-1 OF BOSSINF
* # EASY -
MOVE ERRORMESSAGE-3 TO MESSAGE-2 OF BOSSINF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** LIST-CAN-BE-PRODUCED ***
*---------------------------------------------------------------- # EASY *
LIST-CAN-BE-PRODUCED.
CALL "DELJRNEY" USING JOURNEY, ERROR-SIGN
IF ERROR-SIGN = 0
THEN
MOVE RESULTMESSAGE-2 TO MESSAGE-2 OF BOSSINF
ELSE
MOVE ERRORMESSAGE-2 TO MESSAGE-2 OF BOSSINF
END-IF
MOVE WHERE-TO-GO OF JOURNEY TO WHERE-TO-GO OF BOSSINF
* # EASY -
MOVE BOOKED-SEATS OF JOURNEY TO
BOOKED-SEATS OF BOSSINF
PERFORM PRODUCE-LIST
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PRODUCE-LIST ***
*---------------------------------------------------------------- # EASY *
PRODUCE-LIST.
PERFORM PRINT-LIST-HEADER
IF ERROR-SIGN NOT = 0
THEN
MOVE ERRORMESSAGE-1 TO MESSAGE-1 OF BOSSINF
ELSE
PERFORM PRINT-LIST-ELEMENTS
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PRINT-LIST-HEADER ***
*---------------------------------------------------------------- # EASY *
PRINT-LIST-HEADER.
MOVE JOURNEY-ID OF JOURNEY TO JOURNEY-ID OF LIST-HEADER
* # EASY -
MOVE WHERE-TO-GO OF JOURNEY TO WHERE-TO-GO OF LIST-HEADER
* # EASY -
MOVE BOOKED-SEATS OF JOURNEY TO
BOOKED-SEATS OF LIST-HEADER
* # EASY -
MOVE FPUT TO KCOP
* # EASY -
MOVE "NT" TO KCOM
* # EASY -
MOVE 28 TO KCLM
* # EASY -
MOVE "PRINTER" TO KCRN
* # EASY -
MOVE "*CLHEAD" TO KCMF
CALL "KDCS" USING KCPAC, LIST-HEADER
IF KCRCCC = "000"
THEN
MOVE 0 TO ERROR-SIGN
ELSE
MOVE 1 TO ERROR-SIGN
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PRINT-LIST-ELEMENTS ***
*---------------------------------------------------------------- # EASY *
PRINT-LIST-ELEMENTS.
MOVE JOURNEY-ID OF JOURNEY TO JOURNEY-ID OF BOOKING
CALL "RDBOOKNG" USING BOOKING, ERROR-SIGN
IF ERROR-SIGN NOT = 0
THEN
MOVE ERRORMESSAGE-4 TO MESSAGE-1 OF BOSSINF,
MOVE ERRORMESSAGE-3 TO MESSAGE-2 OF BOSSINF
ELSE
MOVE 0 TO EOF, ERROR-SIGN,
PERFORM WITH TEST BEFORE UNTIL
((EOF NOT = 0) OR
(ERROR-SIGN NOT = 0) OR
(JOURNEY-ID OF BOOKING NOT =
JOURNEY-ID OF JOURNEY)),
PERFORM NEXT-ELEMENT
END-PERFORM
IF ERROR-SIGN = 0
THEN
MOVE RESULTMESSAGE-1 TO MESSAGE-1 OF BOSSINF
ELSE
MOVE ERRORMESSAGE-3 TO MESSAGE-1 OF BOSSINF
END-IF
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** NEXT-ELEMENT ***
*---------------------------------------------------------------- # EASY *
NEXT-ELEMENT.
MOVE BOOKING-ID OF BOOKING TO
BOOKING-ID OF LIST-ELEMENT
* # EASY -
MOVE SEATS-TO-BE-BOOKED OF BOOKING TO
BOOKED-SEATS OF LIST-ELEMENT
* # EASY -
MOVE FIRST-NAME OF BOOKING TO FIRST-NAME OF LIST-ELEMENT
* # EASY -
MOVE SURNAME OF BOOKING TO
SURNAME OF LIST-ELEMENT
* # EASY -
MOVE STREET OF BOOKING TO STREET OF LIST-ELEMENT
* # EASY -
MOVE HOME-TOWN OF BOOKING TO HOME-TOWN OF LIST-ELEMENT
* # EASY -
MOVE PLZ OF BOOKING TO PLZ OF LIST-ELEMENT
PERFORM PRINT-ELEMENT
IF ERROR-SIGN = 0
THEN
CALL "NXTBOOKNG" USING BOOKING, EOF
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY (
**** PRINT-ELEMENT ***
*---------------------------------------------------------------- # EASY *
PRINT-ELEMENT.
MOVE FPUT TO KCOP
* # EASY -
MOVE "NT" TO KCOM
* # EASY -
MOVE 108 TO KCLM
* # EASY -
MOVE "PRINTER" TO KCRN
* # EASY -
MOVE "*CLELEM" TO KCMF
* # EASY -
MOVE ZERO TO KCDF
CALL "KDCS" USING KCPAC, LIST-ELEMENT
IF KCRCCC = "000"
THEN
MOVE 0 TO ERROR-SIGN
ELSE
MOVE 1 TO ERROR-SIGN
END-IF
.
* # EASY P
*---------------------------------------------------------------- # EASY )
*---------------------------------------------------------------- # EASY )
END PROGRAM TOUR029.
*---------------------------------------------------------------- # EASY )